home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / PROGS / TMAP.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-03  |  13KB  |  476 lines
  1. Program TMAP;
  2.  
  3. { to read Turbo MAP files and produce meaningful output }
  4.  
  5. uses DOS, PbMISC, PbDATA, PbOBJS, PbOUT0, PbPARMS;
  6.  
  7. var  TMAP_Data          : byte;  { TMAP marker }
  8.  
  9. type symbolstr = string[22];
  10.  
  11. var  rptlvl             : integer;
  12.      MapName            : string[40];
  13.      CodeEndAddress     : longint;
  14.      DataStartAddress   : longint;
  15.      SortSymbolsFlag    : boolean;
  16.      SortMsg            : string[40];
  17.      DataSegIndex       : integer;
  18.      PrevSegname        : symbolstr;
  19.  
  20. var  ExcludeSymbolsFlag : boolean;
  21.  
  22.  
  23. { Segment map stuff }
  24. type  SegMapType = record
  25.             itemname         : symbolstr;
  26.             baseaddr         : longint;
  27.             endaddr          : longint;
  28.             len              : longint;
  29.             typ              : string[6];
  30.             end;
  31.  
  32. const SegMax = 50;
  33. var   SegMap              : array[1..SegMax] of SegMapType;
  34.       SegCnt              : integer;
  35.  
  36. { Publics map stuff }
  37. type  PubMapType = record
  38.             itemname      : symbolstr;
  39.             baseaddr      : longint;
  40.             len           : longint;
  41.             dataseg       : integer;
  42.             end;
  43. const PubMax = 500;
  44. var   PubMap              : array[1..PubMax] of PubMapType;
  45.       Pubcnt              : integer;
  46.  
  47.  
  48. var  TMAP_DataEnd         : byte;  { TMAP marker }
  49.  
  50.  
  51.  
  52.  
  53. {*PAGE SegMap*}
  54. { -------------  SegMap - Segment Information of the Map file ----------- }
  55.  
  56.  
  57. Procedure InitSegMap;
  58.      begin
  59.      fillchar(SegMap,sizeof(SegMap),0);
  60.      SegCnt := 0;
  61.      end;
  62.  
  63.  
  64. function  FmtSegItem(Seg : SegMapType ) : string;
  65. var s : string;
  66.     s1,s2,s3 : symbolstr;
  67.      begin
  68.      s := '';
  69.      s := s + leftstr(Seg.itemname,20) +
  70.               leftstr(Seg.typ,6);
  71.      str(Seg.baseaddr,s1);  s := s + '  b:' + leftstr(s1,7);
  72.      str(Seg.endaddr,s2);   s := s + '  e:' + leftstr(s2,7);
  73.      str(Seg.len,s3);       s := s + '  l:' + leftstr(s3,7);
  74.      FmtSegItem := s;
  75.      end;
  76.  
  77.  
  78.  
  79. Procedure DecodeSegLine(s : string);
  80. var Seg : SegMapType;
  81. var s1 : symbolstr;
  82.      begin
  83.      fillchar(Seg,sizeof(Seg),0);
  84.      Seg.baseaddr := HexToLongint(copy(s,2,5));
  85.      Seg.endaddr  := HexToLongint(copy(s,9,5));
  86.      Seg.len      := HexToLongint(copy(s,16,5));
  87.      Seg.itemname := copy(s,23,19);
  88.      Seg.typ      := copy(s,42,6) + '    ';
  89.      if SegCnt < SegMax then
  90.           begin
  91.           inc(SegCnt);
  92.           SegMap[SegCnt] := Seg;
  93.           end;
  94.      if leftstr(Seg.typ,4) = 'DATA' then DataStartAddress := Seg.baseaddr;
  95.      if leftstr(Seg.typ,4) = 'CODE' then
  96.           if Seg.endaddr > CodeEndAddress then CodeEndAddress := Seg.endaddr;
  97.      end;
  98.  
  99.  
  100. Procedure SortSegMap;
  101. var i,j : integer;
  102.     Seg  : SegMapType;
  103.      begin
  104.      for i := 1 to SegCnt-1 do
  105.           begin
  106.           for j := i+1 to SegCnt do
  107.                begin
  108.                if SegMap[i].len < SegMap[j].len then
  109.                     begin
  110.                     Seg := SegMap[i];
  111.                     SegMap[i] := SegMap[j];
  112.                     SegMap[j] := Seg;
  113.                     end;
  114.                end;
  115.           end;
  116.      end;
  117.  
  118.  
  119. Procedure ListSegMap(progname : string; lvl : integer);
  120. var i : integer;
  121.     lcode,ldata,lheap,lstack : longint;
  122.      begin
  123.      if lvl >= 0 then
  124.           begin
  125.           lcode := 0; ldata := 0; lheap := 0; lstack := 0;
  126.           for i := 1 to SegCnt do
  127.                begin
  128.                if      SegMap[i].typ = 'CODE  ' then lcode := lcode + SegMap[i].len
  129.                else if SegMap[i].typ = 'DATA  ' then ldata := ldata + SegMap[i].len
  130.                else if SegMap[i].typ = 'STACK ' then lstack:= lstack+ SegMap[i].len
  131.                else if SegMap[i].typ = 'HEAP  ' then lheap := lheap + SegMap[i].len
  132.                else begin end;
  133.                end;
  134.           OUT(leftstr(progname,20)+
  135.                     ' EXE:'+FmtKstr(SizeOfFile(progname,'exe'))+
  136.                     '   Code:'+FmtKstr(lcode)+
  137.                     '   Data:'+FmtKstr(ldata)+
  138.                     '   Stack:'+FmtKstr(lstack)+
  139.                     '   Heap:'+FmtKstr(lheap));
  140.           end;
  141.  
  142.      if lvl > 1 then
  143.           begin
  144.           if SortSymbolsFlag then SortSegMap;
  145.           OUT('Segment Map         entries:'+integerstr(SegCnt-1,3)+
  146.                     '     '+sortmsg);
  147.           for i := 1 to SegCnt-1 do
  148.                begin
  149.                OUT(' - '+FmtSegItem(SegMap[i]));
  150.                end;
  151.           OUT('');
  152.           end;
  153.      end;
  154.  
  155.  
  156.  
  157. {*PAGE PubMap*}
  158. { -------------  PubMap - Public Symbols Information of the Map file ----------- }
  159.  
  160.  
  161. Procedure InitPubMap;
  162.      begin
  163.      fillchar(PubMap,sizeof(PubMap),0);
  164.      Pubcnt := 0;
  165.      end;
  166.  
  167.  
  168. Procedure DecodePubLine(s : string);
  169. var Pub : PubMapType;
  170. var s1 : symbolstr;
  171.      begin
  172.      if length(s) < 10 then exit;
  173.      fillchar(Pub,sizeof(Pub),0);
  174.      Pub.baseaddr := HexAddressToLongint(copy(s,2,9));
  175.      Pub.len      := 0;
  176.      Pub.itemname := copy(s,18,20);
  177.      if Pubcnt < PubMax then
  178.           begin
  179.           inc(Pubcnt);
  180.           PubMap[Pubcnt] := Pub;
  181.           end;
  182.      end;
  183.  
  184.  
  185. Function  FindSegmentIndex(var Pub : PubMapType) : integer;
  186. var s : string[40];
  187.     i,j : integer;
  188.     found : boolean;
  189.      begin
  190.      found := false;
  191.      i := 0;
  192.      j := 1;
  193.      while (i < SegCnt) and not found do
  194.           begin
  195.           inc(i);
  196.           if (Pub.baseaddr >= SegMap[i].baseaddr) and
  197.              (Pub.baseaddr <= SegMap[i].baseaddr + SegMap[i].len) then
  198.                 begin
  199.                 found := true;
  200.                 j := i;
  201.                 end;
  202.           end;
  203.      FindSegmentIndex := j;
  204.      end;
  205.  
  206.  
  207. function  PubItemSegmentName(var Pub : PubMapType) : string;
  208. var s : string[40];
  209.     i : integer;
  210.     l : longint;
  211.      begin
  212.      s := '??';
  213.      i := FindSegmentIndex(Pub);
  214.      if i > 0 then
  215.           begin
  216.           s := SegMap[i].itemname;
  217.           if (Pub.baseaddr + Pub.len) > SegMap[i].endaddr then
  218.                begin
  219.                l := Pub.len;
  220.                Pub.len := SegMap[i].endaddr - Pub.baseaddr;
  221.                end;
  222.           end;
  223.      PubItemSegmentName := s;
  224.      end;
  225.  
  226.  
  227. Procedure ProcessPubItem(var Pub : PubMapType);
  228. var i,seglen,ndx : integer;
  229.     s,segname,suffix : string[40];
  230.      begin
  231.      s := Pub.itemname;
  232.      i := pos('_',s);
  233.      if i > 1 then
  234.           begin
  235.           suffix := s;
  236.           delete(suffix,1,i-1);
  237.           segname := leftstr(s,i-1);
  238.           ndx := 0;
  239.           for i := 1 to SegCnt do
  240.                begin
  241.                seglen := length(segname);
  242.                if segname = leftstr(SegMap[i].itemname,seglen) then ndx := i;
  243.                end;
  244.           Pub.dataseg := DataSegIndex;
  245.           if      suffix = '_DATA' then
  246.                begin
  247.                if ndx > 0 then DataSegIndex := ndx;
  248.                Pub.dataseg := DataSegIndex;
  249.                end
  250.           else if suffix = '_ENDDATA' then DataSegIndex := 0
  251.           else if suffix = '_PRIVATEDATA' then DataSegIndex := 0;
  252.           end
  253.      else Pub.dataseg := DataSegIndex;
  254.      end;
  255.  
  256.  
  257. Procedure ComputePLengths;
  258. var i,j : integer;
  259.     Pub  : PubMapType;
  260.      begin
  261.      if Pubcnt < 2 then exit;
  262.      for i := 1 to Pubcnt-1 do
  263.           begin
  264.           if (PubMap[i+1].baseaddr = DataStartAddress) then
  265.                begin
  266.                PubMap[i].len := CodeEndAddress - PubMap[i].baseaddr;
  267.                end
  268.           else PubMap[i].len := PubMap[i+1].baseaddr - PubMap[i].baseaddr;
  269.           ProcessPubItem(PubMap[i]);
  270.           end;
  271.      end;
  272.  
  273.  
  274. Procedure SortPubMap;
  275. var i,j,x : integer;
  276.     s     : symbolstr;
  277.     Pub  : PubMapType;
  278.      begin
  279.      x := 0;
  280.      for i := 1 to Pubcnt-1 do
  281.          if (PubMap[i].baseaddr < DataStartAddress) then
  282.               begin
  283.               s := PubItemSegmentName(PubMap[i]);  {does length adjustment}
  284.               x := i;
  285.               end;
  286.      for i := 1 to x-1 do
  287.           begin
  288.           for j := i+1 to x do
  289.                begin
  290.                if (PubMap[i].len < PubMap[j].len) then
  291.                     begin
  292.                     Pub := PubMap[i];
  293.                     PubMap[i] := PubMap[j];
  294.                     PubMap[j] := Pub;
  295.                     end;
  296.                end;
  297.           end;
  298.      end;
  299.  
  300.  
  301.  
  302. function  FmtPubItem(Pub : PubMapType ) : string;
  303. var s        : string;
  304.     s1,s2,s3 : symbolstr;
  305.     i        : integer;
  306.      begin
  307.      s := ' ';
  308.      s := s + leftstr(Pub.itemname,20);
  309.      if Pub.baseaddr < DataStartAddress then
  310.           begin
  311.           s := s + '  CODE (' + leftstr(PubItemSegmentName(Pub),20)+ ') ';
  312.           end
  313.      else begin
  314.           s := s + '  DATA (';
  315.           s1 := '';
  316.           i := Pub.dataseg;
  317.           if i > 0 then
  318.                begin
  319.                s1 := leftstr(SegMap[i].itemname,20);
  320.                if s1 <> prevsegname then OUT(' ');
  321.                s := s + s1 + ') ';
  322.                end
  323.           else s := s + '                    ) ';
  324.           prevsegname := s1;
  325.           end;
  326.      str(Pub.baseaddr,s1);  s := s + '  b:' + leftstr(s1,7);
  327.      str(Pub.len,s3);       s := s + '  l:' + leftstr(s3,7);
  328.      FmtPubItem := s;
  329.      end;
  330.  
  331.  
  332. Procedure ListPubMap(progname : string; lvl : integer);
  333. var i : integer;
  334.     excludebytes : longint;
  335.     excludecount : integer;
  336.     KeepSymbol   : boolean;
  337.      begin
  338.      if lvl > 2 then
  339.           begin
  340.           ComputePLengths;
  341.           if SortSymbolsFlag then  SortPubMap;
  342.           OUT('Publics Map         entries:'+integerstr(PubCnt,3)+
  343.                     '     '+sortmsg);
  344.           excludebytes := 0;
  345.           excludecount := 0;
  346.           for i := 1 to Pubcnt do
  347.                begin
  348.                KeepSymbol := (not CheckOK('#'+PubMap[i].itemname))
  349.                              or (not ExcludeSymbolsFlag );
  350.                if KeepSymbol then
  351.                     OUT(FmtPubItem(PubMap[i]))
  352.                else begin
  353.                     excludebytes := excludebytes + PubMap[i].len;
  354.                     inc(excludecount);
  355.                     end;
  356.                end;
  357.           OUT('');
  358.           end;
  359.      if (excludecount > 0) and (rptlvl > 2) then
  360.           begin
  361.           OUT('');
  362.           OUT('There were '+integerstr(excludecount,4)+
  363.               ' Excluded symbols, totaling '+
  364.                 integerstr(excludebytes,5)+' bytes.');
  365.           OUT('');
  366.           end;
  367.      end;
  368.  
  369.  
  370. {*PAGE TMAP Main code*}
  371.  
  372.  
  373.  
  374. Procedure ProcessMapFile(progname: string; lvl : integer);
  375. var s    : string;
  376.     done : boolean;
  377.     tx   : TFILE_object;
  378.      begin
  379.      InitSegMap;
  380.      InitPubMap;
  381.      done := false;
  382.      tx.init(progname,false);
  383.      while tx.fetchnext(s) and (not done) do
  384.           begin
  385.           if (s[7] = 'H') and (s[8] = ' ') then DecodeSegLine(s)
  386.           else if (s[6] = ':') then DecodePubLine(s)
  387.           else begin { writeln('?',s) } end;
  388.           end;
  389.      if SegCnt > 0 then ListSegMap(progname,lvl)
  390.      else OUT('SegMap array is empty.');
  391.      if Pubcnt > 0 then ListPubMap(progname,lvl)
  392.      else OUT('PubMap array is empty.');
  393.      tx.done;
  394.      end;
  395.  
  396.  
  397. Procedure ProcessMapFiles(fn : string; lvl : integer);
  398. var SR :searchrec;
  399.     i  : integer;
  400.     done : boolean;
  401.     fname, dirstr : string[40];
  402.     begin
  403.     fname := fn;
  404.     i := pos('.',fname);
  405.     if i = 0 then fname := fname + '.map';
  406.     i := Pos('*',fname);
  407.     if i = 0 then
  408.          begin
  409.          Getdir(0,dirstr);
  410.          i := pos('\',fname);
  411.          if i = 0 then fname := dirstr + '\' +  fname;
  412.          ProcessMapFile(fname,lvl);
  413.          end
  414.     else begin
  415.          dirstr := fname;
  416.          done := false;
  417.          i := length(fname);
  418.          while (i > 0) and not done do
  419.               begin
  420.               if dirstr[i] = '\' then done := true
  421.               else delete(dirstr,i,1);
  422.               dec(i);
  423.               end;
  424.          FindFirst(fname,anyfile,SR);
  425.          while dosError = 0 do
  426.              begin
  427.              ProcessMapFile(dirstr+SR.name,lvl);
  428.              FindNext(SR);
  429.              end;
  430.          end;
  431.     end;
  432.  
  433.  
  434. Procedure Init;
  435.      begin
  436.      DataSegIndex := 0;
  437.      PrevSegname  := '';
  438.      rptlvl := 0;
  439.      ExcludeSymbolsFlag := true;
  440.      SortSymbolsFlag    := false;
  441.      DataStartAddress := 0;
  442.      CodeEndAddress := 0;
  443.      MapName := '*.map';
  444.  
  445.      addparm(1,'EXCLUDE','YES');
  446.      addparm(1,'SORT','NO');
  447.      addparm(1,'LEVEL','0');
  448.  
  449.      StandardOUTInit;
  450.  
  451.      ExcludeSymbolsFlag := CheckOK('EXCLUDE');
  452.      SortSymbolsFlag    := CheckOK('SORT');
  453.      rptlvl             := GetParmNum('LEVEL');
  454.      if paramcount > 0 then
  455.           begin
  456.           MapName := paramstr(1);
  457.           if ScanParms('1') then rptlvl := 1;
  458.           if ScanParms('2') then rptlvl := 2;
  459.           if ScanParms('3') then rptlvl := 3;
  460.           if ScanParms('4') then rptlvl := 4;
  461.           end
  462.      else ShowdocFile;
  463.      if rptlvl > 2 then pOutFile := 'LPT1';   { assume output to printer }
  464.  
  465.      if SortSymbolsFlag then SortMsg := 'Code entries sorted by size(bytes).'
  466.      else SortMsg := 'Code entries in address order.'
  467.      end;
  468.  
  469.  
  470.      begin    { MAIN }
  471.      pProgID := 'TMAP 1.02';
  472.      Init;
  473.      ProcessMapFiles(MapName, rptlvl);
  474.      OUTDone;
  475.      end.
  476.